home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue42 / comcorn / DAXDoc / AxDocs.pas next >
Encoding:
Pascal/Delphi Source File  |  1999-01-11  |  9.1 KB  |  320 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       ActiveX Document Support Unit                   }
  4. {       Copyright (c) 1999, Steve Teixeira              }
  5. {                                                       }
  6. {*******************************************************}
  7.  
  8. unit AxDocs;
  9.  
  10. interface
  11.  
  12. uses
  13.   Windows, ComObj, ActiveX, AxCtrls, Controls;
  14.  
  15. type
  16.   TActiveXDocument = class(TActiveXControl, IOleDocument, IOleDocumentView)
  17.   private
  18.     function GetAncestorValueByField(FieldNum: Cardinal): Cardinal;
  19.     procedure SetAncestorValueByField(FieldNum, Value: Cardinal);
  20.     function GetOleInPlaceSite: IOleInPlaceSite;
  21.     procedure SetOleInPlaceSite(const Value: IOleInPlaceSite);
  22.   protected
  23.     { IOleDocument methods }
  24.     function CreateView(Site: IOleInPlaceSite; Stream: IStream; rsrvd: DWORD;
  25.       out View: IOleDocumentView):HResult; stdcall;
  26.     function GetDocMiscStatus(var Status: DWORD):HResult; stdcall;
  27.     function EnumViews(out Enum: IEnumOleDocumentViews;
  28.       out View: IOleDocumentView):HResult; stdcall;
  29.     { IOleDocumentView methods }
  30.     function SetInPlaceSite(Site: IOleInPlaceSite):HResult; stdcall;
  31.     function GetInPlaceSite(out Site: IOleInPlaceSite):HResult; stdcall;
  32.     function GetDocument(out P: IUnknown):HResult; stdcall;
  33.     function SetRect(const View: TRECT):HResult; stdcall;
  34.     function GetRect(var View: TRECT):HResult; stdcall;
  35.     function SetRectComplex(const View, HScroll, VScroll, SizeBox):HResult; stdcall;
  36.     function Show(fShow: BOOL):HResult; stdcall;
  37.     function UIActivate(fUIActivate: BOOL):HResult; stdcall;
  38.     function Open:HResult; stdcall;
  39.     function CloseView(dwReserved: DWORD):HResult; stdcall;
  40.     function SaveViewState(pstm: IStream):HResult; stdcall;
  41.     function ApplyViewState(pstm: IStream):HResult; stdcall;
  42.     function Clone(NewSite: IOleInPlaceSite; out NewView: IOleDocumentView):HResult; stdcall;
  43.   public
  44.     function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override;
  45.     property OleInPlaceSite: IOleInPlaceSite read GetOleInPlaceSite write SetOleInPlaceSite;
  46.   end;
  47.  
  48.   TActiveXDocClass = class of TActiveXDocument;
  49.  
  50.   TActiveXDocumentFactory = class(TActiveXControlFactory)
  51.     constructor Create(ComServer: TComServerObject;
  52.       ActiveXDocClass: TActiveXDocClass; WinControlClass: TWinControlClass;
  53.       const ClassID: TGUID; ToolboxBitmapID, MiscStatus: Integer;
  54.       ThreadingModel: TThreadingModel);
  55.     procedure UpdateRegistry(Register: Boolean); override;
  56.   end;
  57.  
  58. implementation
  59.  
  60. uses ComServ;
  61.  
  62. { TActiveXDocument }
  63.  
  64. function TActiveXDocument.ObjQueryInterface(const IID: TGUID; out Obj): HResult;
  65. begin
  66.   // Must stub out IOleLink, or container will assume this is a linked object
  67.   // rather than an embedded object.
  68.   if IsEqualGuid(IID, IOleLink) then Result := E_NOINTERFACE
  69.   else Result := inherited ObjQueryInterface(IID, Obj);
  70. end;
  71.  
  72. function TActiveXDocument.GetOleInPlaceSite: IOleInPlaceSite;
  73. begin
  74.   // Work around fact that FOleInPlaceSite is private in TActiveXControl
  75.   // Note: this work around only guaranteed to work in Delphi 4
  76.   Result := IOleInPlaceSite(GetAncestorValueByField(9));
  77. end;
  78.  
  79. procedure TActiveXDocument.SetOleInPlaceSite(const Value: IOleInPlaceSite);
  80. begin
  81.   // Work around fact that FOleInPlaceSite is private in TActiveXControl
  82.   // Note: this work around only guaranteed to work in Delphi 4
  83.   SetAncestorValueByField(9, Cardinal(Value));
  84. end;
  85.  
  86. function TActiveXDocument.GetAncestorValueByField(FieldNum: Cardinal): Cardinal;
  87. var
  88.   ParentInstanceSize, Ofs: Cardinal;
  89. begin
  90.   // Nasty hack: this method returns the value of a particular field in the
  91.   // ancestor class, with the assumption that the given field and all prior
  92.   // fields are 4 bytes in size.
  93.   ParentInstanceSize := ClassParent.ClassParent.InstanceSize;
  94.   Ofs := ParentInstanceSize + ((FieldNum - 1) * 4);
  95.   asm
  96.     mov eax, Self
  97.     add eax, Ofs
  98.     mov eax, dword ptr [eax]
  99.     mov @Result, eax
  100.   end;
  101. end;
  102.  
  103. procedure TActiveXDocument.SetAncestorValueByField(FieldNum, Value: Cardinal);
  104. var
  105.   ParentInstanceSize, Ofs: Cardinal;
  106. begin
  107.   // Nasty hack: this method sets the value of a particular field in the
  108.   // ancestor class, with the assumption that the given field and all prior
  109.   // fields are 4 bytes in size.
  110.   ParentInstanceSize := ClassParent.ClassParent.InstanceSize;
  111.   Ofs := ParentInstanceSize + ((FieldNum - 1) * 4);
  112.   asm
  113.     mov eax, Self
  114.     add eax, Ofs
  115.     mov ecx, Value
  116.     mov dword ptr [eax], ecx
  117.   end;
  118. end;
  119.  
  120. { TActiveXDocument.IOleDocument }
  121.  
  122. function TActiveXDocument.CreateView(Site: IOleInPlaceSite;
  123.   Stream: IStream; rsrvd: DWORD; out View: IOleDocumentView): HResult;
  124. var
  125.   OleDocView: IOleDocumentView;
  126. begin
  127.   Result := S_OK;
  128.   try
  129.     if View = nil then
  130.     begin
  131.       Result := E_POINTER;
  132.       Exit;
  133.     end;
  134.     OleDocView := Self as IOleDocumentView;
  135.     if (OleInPlaceSite = nil) or (OleDocView = nil) then
  136.     begin
  137.       Result := E_FAIL;
  138.       Exit;
  139.     end;
  140.     // Use site provided
  141.     if Site <> nil then OleDocView.SetInPlaceSite(Site);
  142.     // Use stream provided for initialization
  143.     if Stream <> nil then OleDocView.ApplyViewState(Stream);
  144.     // Return the view
  145.     View := OleDocView;
  146.   except
  147.     Result := E_FAIL;
  148.   end;
  149. end;
  150.  
  151. function TActiveXDocument.EnumViews(out Enum: IEnumOleDocumentViews;
  152.   out View: IOleDocumentView): HResult;
  153. begin
  154.   Result := S_OK;
  155.   try
  156.     // We only support one view
  157.     View := Self as IOleDocumentView;
  158.   except
  159.     Result := E_FAIL;
  160.   end;
  161. end;
  162.  
  163. function TActiveXDocument.GetDocMiscStatus(var Status: DWORD): HResult;
  164. begin
  165.   Status := 8 {DOCMISC_NOFILESUPPORT};
  166.   Result := S_OK;
  167. end;
  168.  
  169. { TActiveXDocument.IOleDocument }
  170.  
  171. function TActiveXDocument.ApplyViewState(pstm: IStream): HResult;
  172. begin
  173.   Result := E_NOTIMPL;
  174. end;
  175.  
  176. function TActiveXDocument.Clone(NewSite: IOleInPlaceSite;
  177.   out NewView: IOleDocumentView): HResult;
  178. begin
  179.   Result := E_NOTIMPL;
  180. end;
  181.  
  182. function TActiveXDocument.CloseView(dwReserved: DWORD): HResult;
  183. begin
  184.   Result := S_OK;
  185.   try
  186.     Show(False);
  187.     SetInPlaceSite(nil);
  188.   except
  189.     Result := E_UNEXPECTED;
  190.   end;
  191. end;
  192.  
  193. function TActiveXDocument.GetDocument(out P: IUnknown): HResult;
  194. begin
  195.   Result := S_OK;
  196.   try
  197.     P := Self as IUnknown;
  198.   except
  199.     Result := E_FAIL;
  200.   end;
  201. end;
  202.  
  203. function TActiveXDocument.GetInPlaceSite(out Site: IOleInPlaceSite): HResult;
  204. begin
  205.   Result := S_OK;
  206.   try
  207.     Site := OleInPlaceSite;
  208.   except
  209.     Result := E_FAIL;
  210.   end;
  211. end;
  212.  
  213. function TActiveXDocument.GetRect(var View: TRECT): HResult;
  214. begin
  215.   Result := S_OK;
  216.   try
  217.     View := Control.BoundsRect;
  218.   except
  219.     Result := E_UNEXPECTED;
  220.   end;
  221. end;
  222.  
  223. function TActiveXDocument.Open: HResult;
  224. begin
  225.   Result := E_NOTIMPL;
  226. end;
  227.  
  228. function TActiveXDocument.SaveViewState(pstm: IStream): HResult;
  229. begin
  230.   Result := E_NOTIMPL;
  231. end;
  232.  
  233. function TActiveXDocument.SetInPlaceSite(Site: IOleInPlaceSite): HResult;
  234. begin
  235.   Result := S_OK;
  236.   try
  237.     if OleInPlaceSite <> nil then
  238.       Result := InPlaceDeactivate;
  239.     if Result <> S_OK then Exit;
  240.     if Site <> nil then OleInPlaceSite := Site;
  241.   except
  242.     Result := E_UNEXPECTED;
  243.   end;
  244. end;
  245.  
  246. function TActiveXDocument.SetRect(const View: TRECT): HResult;
  247. begin
  248.   // Implement using TActiveXControl's IOleInPlaceObject.SetObjectRects impl
  249.   Result := SetObjectRects(View, View);
  250. end;
  251.  
  252. function TActiveXDocument.SetRectComplex(const View; const HScroll;
  253.   const VScroll; const SizeBox): HResult;
  254. begin
  255.   Result := E_NOTIMPL;
  256. end;
  257.  
  258. function TActiveXDocument.Show(fShow: BOOL): HResult;
  259. begin
  260.   try
  261.     if fShow then
  262.       Result := InPlaceActivate(False)
  263.     else begin
  264.       Result := UIActivate(False);
  265.       Control.Visible := False;
  266.     end;
  267.   except
  268.     Result := E_UNEXPECTED;
  269.   end;
  270. end;
  271.  
  272. function TActiveXDocument.UIActivate(fUIActivate: BOOL): HResult;
  273. begin
  274.   Result := S_OK;
  275.   try
  276.     if FUIActivate then
  277.     begin
  278.       if OleInPlaceSite <> nil then InPlaceActivate(True)
  279.       else Result := E_UNEXPECTED;
  280.     end
  281.     else
  282.       UIDeactivate;
  283.   except
  284.     Result := E_UNEXPECTED;
  285.   end;
  286. end;
  287.  
  288. { TActiveXDocumentFactory }
  289.  
  290. constructor TActiveXDocumentFactory.Create(ComServer: TComServerObject;
  291.   ActiveXDocClass: TActiveXDocClass; WinControlClass: TWinControlClass;
  292.   const ClassID: TGUID; ToolboxBitmapID, MiscStatus: Integer;
  293.   ThreadingModel: TThreadingModel);
  294. begin
  295.   inherited Create(ComServer, ActiveXDocClass, WinControlClass, ClassId,
  296.     ToolboxBitmapID, '', MiscStatus, ThreadingModel);
  297. end;
  298.  
  299. procedure TActiveXDocumentFactory.UpdateRegistry(Register: Boolean);
  300. var
  301.   ClassKey: string;
  302. begin
  303.   ClassKey := 'CLSID\' + GUIDToString(ClassID) + '\';
  304.   if Register then
  305.   begin
  306.     inherited UpdateRegistry(Register);
  307.     CreateRegKey(ClassKey + 'DocObject', '', '8');
  308.     CreateRegKey(ClassKey + 'Programmable', '', '');
  309.     CreateRegKey(ClassKey + 'Insertable', '', '');
  310.   end
  311.   else begin
  312.     DeleteRegKey('DocObject');
  313.     DeleteRegKey('Programmable');
  314.     DeleteRegKey('Insertable');
  315.     inherited UpdateRegistry(Register);
  316.   end;
  317. end;
  318.  
  319. end.
  320.